home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / msm-2 / tests.sit / tests / recent2.icn < prev    next >
Encoding:
Text File  |  1992-12-08  |  5.1 KB  |  210 lines  |  [TEXT/????]
  1. procedure main ()
  2.  
  3. # test ord() and char(), and print messages if wrong results
  4.  
  5.    s := string (&cset)
  6.    every i := 0 to 255 do {
  7.       c := char (i)
  8.       n := ord (c)
  9.       if n ~= i | c ~== s[i+1] then
  10.      write ("oops -- ord/char failure at ",i)
  11.    }
  12.    if char("47") ~== char(47) then
  13.       write ("oops -- type conversion failed in char()")
  14.    if ord(9) ~= ord("9") then
  15.       write ("oops -- type conversion failed in ord()")
  16.  
  17.    every ferr (char, -65536 | -337 | -1 | 256 | 4713 | 65536 | 123456, 205)
  18.    every ferr (char, "abc" | &lcase | &errout | [], 101)
  19.    every ferr (ord, "" | "ab" | "antidisestablishmentarianism" | 47, 205)
  20.    every ferr (ord, &output | table(), 103)
  21.  
  22. #  test getenv()
  23.  
  24.    write(getenv("HOME") | write("getenv failed"))
  25.    write(getenv("foo") | write("getenv failed"))
  26.  
  27. #  test sorting
  28.  
  29.    a := list(1)        # different sizes to make identification easy
  30.    b := list(2)
  31.    c := list(3)
  32.    d := list(4)
  33.    e := &lcase ++ &ucase
  34.    f := &lcase ++ &ucase
  35.    g := '123456789'
  36.    h := &digits
  37.    A := sort([h,g,a,c,b,d,f,e,&lcase,[],&cset,&ascii])
  38.    every write(image(!A))
  39.  
  40. # test varargs
  41.  
  42.    write("p(1):")
  43.    p(1)
  44.    write("p(1, 2):")
  45.    p(1, 2)
  46.    write("p(1, 2, 3):")
  47.    p(1, 2, 3)
  48.    write("p(1, 2, 3, 4, 5):")
  49.    p(1, 2, 3, 4, 5)
  50.    write("q(1, 2):")
  51.    q(1, 2)
  52.  
  53. # test Version 7 table features
  54.  
  55.    write("t := table(\"default\") --> ", image(t := table("default")) |
  56.       "failure")
  57.    show(t)
  58.    write("insert(t, 3, 4) --> ", image(insert(t, 3, 4)) | "failure")
  59.    write("insert(t, \"xyz\", \"abc\") --> ", image(insert(t, "xyz", "abc")) |
  60.       "failure")
  61.    write("insert(t, &digits) --> ", image(insert(t, &digits)) | "failure")
  62.    show(t)
  63.    write("t[\"xyz\"] := \"new value\" --> ", image(t["xyz"] := "new value") |
  64.       "failure")
  65.    show(t)
  66.    write("insert(t, \"xyz\", \"def\") --> ", image(insert(t, "xyz", "def")) |
  67.       "failure")
  68.    show(t)
  69.    write("delete(t, \"xyz\") -- > ", image(delete(t, "xyz")) | "failure")
  70.    show(t)
  71.    write("delete(t, \"xyz\") -- > ", image(delete(t, "xyz")) | "failure")
  72.    show(t)
  73.  
  74. #  test multiple subscripts
  75.    
  76.    write("t := table(\"default\") --> ", image(t := table("default")) |
  77.       "failure")
  78.    write("t[\"one\"] := 1 --> ", image(t["one"] := 1) | "failure")
  79.    write("t[] --> ", image(t[]) | "failure")
  80.    write("x := r1([t, [1, [2, 3]]]) --> ", image(x := r1([t, [1, [2, 3]]])) |
  81.       "failure")
  82.    write("x[1, 1, \"one\"] --> ", image(x[1, 1, "one"]) | "failure")
  83.    write("x[1, 2, 2, 2] --> ", image(x[1, 2, 2, 2]) | "failure")
  84.    write("x[1, 2] := [\"abcd\", \"defg\"] --> ",
  85.       image(x[1, 2] := ["abcd", "defg"]) | "failure")
  86.    write("x[1, 2, 2, 2] --> ", image(x[1, 2, 2, 2]) | "failure")
  87.  
  88. #  test run-time error mechanism
  89.  
  90. end
  91.  
  92. # write word in hexadecimal
  93. procedure word (v)
  94.    xd (v, 8)
  95.    writes (" ")
  96.    return
  97.    end
  98.  
  99. # write n low-order hex digits of v
  100. procedure xd (v, n)
  101.    xd (ishift (v, -4), 0 < n - 1)
  102.    writes ("0123456789ABCDEF" [1 + iand (v, 16r0F)])
  103.    return
  104.    end
  105. # ferr(func,val,err) -- call func(val) and verify that error "err" is produced
  106.  
  107. procedure ferr (func, val, err)
  108.    write(msg := "oops -- " || image(func) || "(" || image (val) || ") ")
  109.    return
  110. end
  111.  
  112. procedure p(a, b, c[])
  113.    write("   image(a):", image(a))
  114.    write("   image(b):", image(b))
  115.    write("   image(c):", image(c))
  116.    write("   every write(\"\\t\", !c):")
  117.    every write("\t", !c)
  118. end
  119.  
  120. procedure q(a[])
  121.    write("   every write(\"\\t\", !a):")
  122.    every write("\t", !a)
  123. end
  124. procedure show(t)
  125.    local x
  126.  
  127.    write("   *t --> ", *t)
  128.    write("   t[\"xyz\"] --> ", image(t["xyz"]) | "failure")
  129.    write("   member(t, \"xyz\") --> ", image(member(t, "xyz")) | "failure")
  130.    x := sort(t, 3)
  131.    write("   contents of t:")
  132.    while writes("\t", image(get(x)), " : ")
  133.       do write(image(get(x)))
  134.    write("")
  135. end
  136.  
  137. #  test the new sortf(x,n) function
  138.  
  139. global data
  140. record r1(a)
  141. record r3(a,b,c)
  142.  
  143. procedure sf (args)
  144.     local n, z
  145.  
  146.     z := []
  147.     every put (z, 1 to 100)
  148.     data := [
  149.        r3(3,1,4),
  150.        [1,5,9],
  151.        r3(2,6,5),
  152.        r3(3,5),
  153.        r1(2),
  154.        3,
  155.        r1(4),
  156.        r1(8),
  157.        [5,&null,5],
  158.        [4,4,4,4],
  159.        [3,3,3],
  160.        [&null,25],
  161.        4,
  162.        [2,2],
  163.        [1],
  164.        [&null,&null],
  165.        [],
  166.        r3(7,8,9),
  167.        z]
  168.     dump ("sort(L)", sort (data))
  169.  
  170.     if *args = 0 then
  171.     every test (&null | 1 | "2" | '3' | 4 | 17 | -4 | -3 | "-2" | -1)
  172.     else
  173.     every test (!args)
  174.     end
  175.  
  176. procedure test (n)
  177.     local r1, r2
  178.     write ()
  179.     write ("-------------------- testing n = ", \n | "&null")
  180.     r1 := sortf (data, n)
  181.     r2 := sortf (set(data), n)
  182.     dump ("sortf(L,n)", r1)
  183.     if same (r1, r2) then
  184.     write ("\nsortf(S,n) [same]")
  185.     else
  186.     dump ("sortf(S,n) [********** OOPS -- results differ: **********]", r2)
  187.     end
  188.  
  189. procedure dump (s, l)
  190.     local e
  191.     write ()
  192.     write (s, ":")
  193.     every e := !l do {
  194.        writes ("  ", left(type(e), 8))
  195.        if (type(e) == ("r1" | "r3" | "list")) then
  196.       every writes (" ", image(e[(1 to 5) | (95 to 100)]) | "\n")
  197.        else
  198.       write (" ", image(e))
  199.        }
  200.     return
  201.     end
  202.  
  203. procedure same (a, b)
  204.     local i
  205.     if *a ~= *b then fail
  206.     every i := 1 to *a do
  207.     if a[i] ~=== b[i] then fail
  208.     return
  209.     end
  210.